perm filename FONTS.SAI[PUB,TES]2 blob
sn#136601 filedate 1974-12-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGOF("FONTS")
C00005 00003 IFK PASSONE THENK
C00006 00004 IFK PASSONE THENK
C00007 00005 IFK PASSONE THENK
C00009 00006 IFK PASSONE THENK
C00011 00007 IFK PASSONE THENK
C00013 00008 IFK PASSONE THENK
C00014 00009 IFK PASSONE OR PASSTWO THENK
C00017 00010 IFK PASSONE THENK
C00018 00011 IFK PASSONE THENK
C00021 00012 IFK PASSONE THENK
C00023 00013 IFK PASSONE THENK
C00024 00014 IFK PASSONE THENK
C00025 00015 IFK PASSONE THENK
C00027 00016 IFK PASSONE THENK
C00028 00017 IFK PASSONE THENK
C00030 00018 IFK PASSONE THENK
C00031 00019 IFK PASSONE THENK
C00032 ENDMK
C⊗;
BEGOF("FONTS")
IFC PASSONE THENC
COMMENT
*** Variations at Different Sites ***
Font file formats differ at each site. Default device parameters
(mostly specified in PUBDFS.SAI and COMDFS.SAI, but partly in
SETDEVICEPARAMETERS) also differ. Character width checking is only
enabled at some sites (XLENGTH).
***
This module handles device characteristics, fonts, pichars, and
raster measurements. Some of it is shared by passes one and two, but
most of it is for pass one only.
The trickiest thing is the font numbering system. There are three
numbering systems: the one in the FONT declaration (one character 0-9
A-F), the one used to index arrays (0-16), and the one expected by
the device (varies). Yechh!
;
ENDC
IFCR PARCVER THENC
DEFINE MAXNEQUIVS = [100] ;
INTEGER NEQUIVS ;
OWN STRING ARRAY EQUIV[1:MAXNEQUIVS, 2:4] ;
ENDC
PROCEDURES
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE FONTS! ;$"#
BEGIN "FONTS!"
WCW ← WHATIS(CW) ; COMMENT original font ;
THISFONT ← OLDFONT ← DEFAULTFONT ;
FSFONT ← DEFAULTFONT ; TES 11/29/73 ;
LOFONT ← 99 ; HIFONT ← 0 ; TES 8/24/74 ;
ODDLEFTBORDER ← ODDLEFTBORDERDEFAULT ; EVENLEFTBORDER ← EVENLEFTBORDERDEFAULT ; TES 8/21/74 ;
SETDEVICEPARAMETERS(ABS(DEVICE)) ; TES 8/24/74 ;
END "FONTS!" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE DDEVICE ;$"#
BEGIN PASS ;
RKJ: 19-AUG-74 ADDED ON BELOW;
IF DEVICE GEQ 0 AND ON THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
BEGIN
IFCR PARCVER THENC PARCMIC ENDC
IF ITS(MIC) THEN DEVICE←MIC
ELSE IF ITS(TTY) THEN DEVICE←TTY
ELSE IF ITS(LPT) THEN DEVICE←LPT
ELSE IF ITS(XGP) THEN DEVICE←XGP
ELSE BEGIN WARN("=","No such device: "&THISWD) ; PASS ; RETURN END ;
SETDEVICEPARAMETERS(ABS(DEVICE)) ; TES 8/24/74 ;
END ;
PASS ;
END "DDEVICE" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE DFONT(BOOLEAN SELECT) ;$"#
BEGIN "DFONT"
INTEGER F;
PASS;
IFC PARCVER THENC
IF ITS(EQUIVALENCE) THEN TES 10/21/74 ;
WHILE TRUE DO
BEGIN
IF NEQUIVS<MAXNEQUIVS THEN NEQUIVS←NEQUIVS+1
ELSE WARN(NULL,"Exceeded limit of " & CVS(MAXNEQUIVS) & " FONT EQUIVALENCEs") ;
FOR F ← 2, XGP, MIC DO
BEGIN
PASS ;
EQUIV[NEQUIVS,F] ← E(NULL, NULL) ;
IF NOT ITSCH(<,>) THEN DONE ;
END ;
IF NOT ITSCH(<,>) THEN RETURN ;
END ;
ENDC
IF LENGTH(THISWD)=1 AND THISTYPE GEQ 0 AND (F←RFONT(THISWD)) GEQ 0 THEN PASS
ELSE F ← RFONT(E(NULL,NULL)) ; TES 11/29/73 ;
IF F<0 THEN
BEGIN WARN("=",<"Illegal font '"&F&"'">); RETURN END;
IF SELECT THEN SELECTFONT(F) TES 1/22/74 ADDED OPTIONAL XGP FILENAME ;
ELSE READFONT(F,E(NULL,NULL), IF ITSCH(<,>) THEN PASS&E(NULL,NULL) ELSE NULL);
END "DFONT";
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE DPICHAR ;$"#
BEGIN TES 11/29/73 ;
INTEGER KEY, IX, F, N ; STRING S ;
INPICHAR ← TRUE ;
S ← NULL ;
PASS ;
KEY ←E(NULL,NULL) ;
IF ITSCH(<(>) THEN
BEGIN COMMENT TURN ON ;
PASS ;
DO S ← S & E(NULL,NULL) UNTIL ITSCH(<)>) ;
PASS ;
IF ITS(WIDTH) THEN
BEGIN PASS ;
IF ITS(OF) THEN BEGIN PASS ; F←'177; N←CVD(E(NULL,NULL)) END
ELSE BEGIN F←CVD(E(NULL,NULL)); N←F MOD '177; F←F DIV '177 END
END
ELSE BEGIN F←'177 ; N ← SP END ;
S ← F & N & S ;
END
ELSE S ← NULL ; COMMENT TURN OFF ;
IX ← PUSHI(PIWDS,PITYPE) ;
PIKEY(IX) ← KEY ; PIVAL(IX) ← PUSHS(1, PICHAR[KEY]) ;
PICHAR[KEY] ← S ;
INPICHAR ← FALSE ;
END "DPICHAR" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE STRING PROCEDURE FONTEQUIV(STRING ABBREV) ;$"#
BEGIN "FONTEQUIV" TES 10/21/74 CALLED BY OPENTOREAD ;
IFCR PARCVER THENC
INTEGER I, D ; STRING ALTNAME ;
IF ABS(DEVICE) LEQ 2 THEN RETURN(NULL) ;
ABBREV ← CAPITALIZE(ABBREV) ;
FOR D ← 2, XGP+MIC-ABS(DEVICE) DO
FOR I ← NEQUIVS STEP -1 UNTIL 1 DO
IF EQU(EQUIV[I,D], ABBREV) THEN
BEGIN
ALTNAME ← EQUIV[I, ABS(DEVICE)] ;
IF NULSTR(ALTNAME) THEN CONTINUE ;
IF ALTNAME = "*" THEN
BEGIN
LOPP(ALTNAME) ;
IF NOT SWDBACK THEN OUTSTR(CRLF) ; SWDBACK ← TRUE ;
OUTSTR("Closest FONT to " & ABBREV & " is " & ALTNAME & CRLF) ;
END ;
IF EQU(ALTNAME, ABBREV) THEN CONTINUE ;
RETURN(ALTNAME) ;
END ;
RETURN(NULL) ;
ENDC
END "FONTEQUIV" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE STRING PROCEDURE MASH(STRING S) ;$"#
BEGIN COMMENT TES 8/14/74 UNPACK 7-BIT BYES TO 64-EXCESS 4-BIT BYTES;
INTEGER C ; STRING Q ;
Q ← NULL ;
WHILE FULSTR(S) DO
BEGIN
C ← LOP(S) ;
Q ← Q & ((C LSH -4)+64) & ((C LAND '17)+64) ;
END ;
RETURN(Q) ;
END ;
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC SIMPLE INTEGER PROCEDURE PERUSEFONT(INTEGER WHICH, CHAN) ;$"#
BEGIN
INTEGER I, K, FSIZE ;
IFCR ITSVER THENC PJ 5/28/74 ;
WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←LDB(POINT(9,FNTINF[WHICH],17));
FNTINF[WHICH]←LDB(POINT(18,FNTINF[WHICH],35)); comment HEIGHT;
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
BEGIN
DUMMY←LDB(POINT(18,DUMMY←WORDIN(CHAN),35));
CW[DUMMY]←LDB(POINT(18,CW[DUMMY]←WORDIN(CHAN),35));
END
ENDC
IFCR CMUXGP THENC RKJ: MODIFIED 7-nov-74;
WORDIN(CHAN); COMMENT KST ID;
FNTINF[WHICH]←WORDIN(CHAN); COMMENT RKJ 10-10-73;
IF (DUMMY←WORDIN(CHAN)) NEQ 2 THEN
BEGIN "FORMAT 1"
LABEL whattakludge;
IF DUMMY LAND 1 THEN GO whattakludge;
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
whattakludge: BEGIN DUMMY←WORDIN(CHAN); CW[DUMMY]←WORDIN(CHAN) END
END "FORMAT 1"
ELSE
BEGIN "FORMAT 2"
IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN) ELSE WORDIN(CHAN);
ARRYIN(CHAN,CW[0],6); COMMENT UNUSED WORDS;
ARRYIN(CHAN,CW[0],128); COMMENT XWD INCR,WIDTH;
FOR I←0 THRU 127 DO CW[I]←CW[I] LSH -18;
END "FORMAT 2";
ENDC
IFCR SAILVER THENC
ARRYIN(CHAN,CW[0],128);
FOR I ← 0 THRU 127 DO CW[I] ← IF CW[I] THEN CW[I] LSH -18 ELSE -1 ; BH 11/5/74;
WORDIN(CHAN); FNTINF[WHICH]←WORDIN(CHAN);
WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN);
ENDC
IFCR PARCVER THENC
BEGIN
EXTERNAL INTEGER GOGTAB;
INTEGER I, K ;
SFBSZ(CHAN, 16) ;
IF ABS(DEVICE)=MIC THEN
PARCFILE
ELSE BEGIN
K←WORDIN(CHAN); WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN); WORDIN(CHAN);
FOR I←1 THRU K DO WORDIN(CHAN);
K←(K MIN 128)-1;
FOR I←0 THRU K DO CW[I]←WORDIN(CHAN);
END ;
END;
ENDC;
RETURN(FSIZE) ;
END "PERUSEFONT" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ;$"#
RETURN(FONTCHAR&"F"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10))));
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE READFONT(INTEGER WHICH; STRING FILENAME, BFILENAME) ;$"#
IF ON AND XCRIBL THEN TES 8/24/74 PROCEDURIZED AND SIMPLIFIED;
BEGIN "READFONT"
INTEGER SAVCW, CHAN;
SAVCW ← WHATIS(CW);
IF FNTFIL[WHICH] = 0 THEN FNTFIL[WHICH] ← CREATE(0,127);
DUMMY ← FNTFIL[WHICH] ;
IF SAVCW=WCW AND WHICH=DEFAULTFONT THEN SAVCW←DUMMY;
MAKEBE(DUMMY,CW);
CHAN ← OPENTOREAD('14, "Font file ", FILENAME,
FONTEXT, FONTPPN) ;
PERUSEFONT(WHICH, CHAN) ;
IF NULSTR(BFILENAME) THEN TES Didn't specify special name for XGP driver ;
IFCR TENEX THENC
BEGIN STRING NAME, EXT, PPN ;
NAME←CVFIL(FILENAME,EXT,PPN) ;
BFILENAME ← NAME & EXT ;
END ;
ELSEC
BFILENAME ← FILENAME ;
ENDC
XFNTNAME[WHICH] ← BFILENAME ;
FNTNAME[WHICH] ← FILENAME ;
IFCR SAILVER THENC
BEGIN INTEGER NAME, EXT, PPN ;
BH 12/13/74 TO FLUSH ".FNT[XGP,SYS]" FROM .XGP FILE ;
NAME←CVFIL(FILENAME,EXT,PPN) ;
IF EXT=FONTEXT THEN EXT←0 ;
IF PPN=FONTPPN THEN PPN←0 ;
CMDFILE ← CMDFILE & "/FONT#" & CVS(WHICH-1) & "=" &
UNCVFIL (0,NAME,EXT,PPN) ;
END
ENDC;
IFCR ITSVER THENC PJ 6/12/74 ;
CMDFILE ← CMDFILE & ";KSET "&(",,,,,,,,,,"[1 FOR WHICH-1])&FILENAME & CRLF ;
ENDC
HIFONT ← WHICH MAX HIFONT ; LOFONT ← WHICH MIN LOFONT ; TES 8/24/74 ;
RELEASE(CHAN);
MAKEBE(SAVCW,CW);
END "READFONT";
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ;$"#
RETURN( TES SUBROUTINIZED AND CASED 11/29/73 ;
IFCR SAILXGP THENC
IF "1" LEQ F LEQ "9" THEN F-"0"
ELSE IF "A" LEQ F LEQ "Z" THEN F-("A"-10)
ELSE IF "a" LEQ F LEQ "z" THEN F-("a"-10)
ELSE -1
ENDC
IFCR PARCVER THENC
IF ABS(DEVICE)=XGP THEN
IF "1" LEQ F LEQ "9" THEN F-"0"
ELSE -1
ELSE IF ABS(DEVICE)=MIC THEN
IF "0" LEQ F LEQ "9" THEN F-"0"
ELSE IF "A" LEQ F LEQ "F" THEN F-("A"-10)
ELSE IF "a" LEQ F LEQ "f" THEN F-("a"-10)
ELSE -1
ELSE 1
ENDC
IFCR CMUXGP THENC
IF "A" LEQ F LEQ "B" THEN F-("A"-10)
ELSE IF "a" LEQ F LEQ "b" THEN F-("a"-10)
ELSE IF "1" LEQ F LEQ "2" THEN F-"0"
ELSE -1
ENDC
) ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE SELECTFONT(INTEGER WHICH) ;$"#
IF ON THEN
BEGIN "SELECTFONT"
INTEGER F;
DBREAK;
IF NOT XCRIBL OR LAST<4 THEN RETURN;
F←(IF WHICH<10 THEN (WHICH+"0") ELSE (WHICH+("A"-10)));
IF FNTFIL[WHICH]=0 THEN BEGIN WARN("=",<"Unknown font '"& F & "'">);
RETURN END;
SWITCHFONT(WHICH) ; TES 11/14/73 SUBROUTINIZED ;
END "SELECTFONT";
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ;$"#
BEGIN TES 11/15/73 TO DO IT BY AREA ;
INTEGER NEWIX ;
IF AREAIXM AND FONTSIX(AREAIXM) < OLDIHED THEN
BEGIN TES FIRST CHANGE IN THIS BLOCK IN THIS AREA ;
NEWIX ← PUSHI(FONTWDS, FONTYPE) ;
AREAX(NEWIX) ← AREAIXM ;
OUTERX(NEWIX) ← FONTSIX(AREAIXM) ;
THISFONTX(NEWIX) ← THISFONT ;
OLDFONTX(NEWIX) ← OLDFONT ;
FONTSIX(AREAIXM) ← NEWIX ;
END ;
OLDFONT ← THISFONT;
IF THISFONT NEQ WHICH THEN
BEGIN
THISFONT ← WHICH;
WHICH ← FNTFIL[WHICH]; MAKEBE(WHICH,CW);
END ;
END ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE SETDEVICEPARAMETERS(INTEGER DEVICE) ;$"#
BEGIN TES 8/24/74 ;
STRING ABBREV, EQD ;
DEFINE GETS = [← CASE DEVICE-1 OF];
COMMENT DEVICES 1=LPT 2=TTY 3=MIC 4=XGP ;
COMMENT ----- ----- ----- ----- ;
CHARW GETS (1, 1, 40, 16) ;
MINCHARW GETS (1, 1, 0, IFC SAILVER THENC 0 ELSEC 1 ENDC) ;
XCRIBL GETS (FALSE, FALSE, TRUE, TRUE) ;
VBPI GETS (6, 6, VBPIMIC, VBPIXGP) ;
HBPI GETS (10, 10, HBPIMIC, HBPIXGP) ;
MINLFTMAR GETS (0, 0, MICMINLFTMAR, XGPMINLFTMAR) ;
VUNDERLINE GETS (BAR,
IFC PARCVER THENC NULL ELSEC BAR ENDC,
BAR, BAR) ;
IFC CMUVER THENC
IF XCRIBL AND NULSTR(FNTNAME[1]) THEN
BEGIN
READFONT(DEFAULTFONT,"NGR25.KST[A730KS00]",NULL);
END ;
ENDC
END "SETDEVICEPARAMETERS" ;
ENDC
IFK PASSONE THENK
PUBLIC STRING SIMPLE PROCEDURE TRUNCATE(STRING STR; INTEGER LEN) ;$"#
BEGIN "TRUNCATE" COMMENT RETURN INITIAL SUBSTRING OF STR OF XLEN LEQ LEN ;
STRING S; INTEGER I,L;
S←STR; I←L←0;
WHILE FULSTR(S) DO
BEGIN
IF (L←L+CW[LOP(S)])>LEN THEN RETURN(STR[1 TO I]);
I←I+1;
END;
RETURN(STR);
END "TRUNCATE";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE XLENGTH(STRING CHARS) ;$"#
BEGIN "XL"
INTEGER COUNT,CH,W,MAXCHARW;
IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
IF NOT ON THEN RETURN(0) ; TES 10/20/74 ;
COUNT←0; MAXCHARW←XMAXIM; TES 8/24/74 ;
WHILE FULSTR(CHARS) DO
IFCR SAILVER OR PARCVER THENC
BEGIN TES 8/14/74, HOW ABOUT CMU & ITS ? ;
IF MINCHARW LEQ (W← CW[ CH←LOP(CHARS) ]) LEQ MAXCHARW THEN
COUNT ← COUNT + W
ELSE WARN("Bad FONT char", <"The character '" & CVOS(CH) &
" has an unusual FONT width " & CVS(W) &
(IF NULSTR(FNTNAME[THISFONT]) THEN CRLF & "because you forgot to declare FONT "
ELSE " in " & FNTNAME[THISFONT] & " FONT ") &
PICKFONT(THISFONT)[3 TO 3]>) ;
END ;
ELSEC
COUNT ← COUNT + CW[LOP(CHARS)];
ENDC
RETURN (COUNT);
END;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE XSPLEN(INTEGER N) ;$"#
RETURN(N * CW[SP]);
ENDC
IFK PASSONE THENK
FINISHED
ENDOF("FONTS")
ENDC